home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_87 / vtpartit.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  10KB  |  441 lines
  1. UNIT VTPartitura;
  2.  
  3. INTERFACE
  4.  
  5. USES SongUnit, PlayMod,
  6.      Output43;
  7.  
  8. VAR
  9.   IsBig       : BOOLEAN;
  10.   PartWin     : PWindow;
  11. {
  12.   ForceReDraw : BOOLEAN;
  13. }
  14.  
  15.  
  16.  
  17.  
  18.  
  19. PROCEDURE SetPartWindow(x, y, p, f: WORD);
  20.  
  21. PROCEDURE SetBigPartWindow;
  22.  
  23. PROCEDURE SetSmallPartWindow;
  24.  
  25. PROCEDURE DrawPartiture(VAR Song: TSong; mdpos, mdseq: WORD);
  26.  
  27.  
  28.  
  29.  
  30. IMPLEMENTATION
  31.  
  32. USES VTPlay, VTWins, VTBitmaps,
  33.      SongUtils, SongElements,
  34.      HexConversions;
  35.  
  36. TYPE
  37.   TFullNoteStr = STRING[18];
  38.  
  39. VAR
  40.   wx, wn,
  41.   py, fy,
  42.   hp, hf,
  43.  
  44.   PastNotes,
  45.   FutNotes,
  46.   TotNotes,
  47.   ActNote,
  48.   FirstNote   : WORD;
  49.  
  50.   ps          : ARRAY[1..33] OF ARRAY[1..4] OF TFullNoteStr;
  51.   fs          : ARRAY[1..33] OF ARRAY[1..4] OF BOOLEAN;
  52.   ls          : ARRAY[1..33] OF ARRAY[1..4] OF TFullNote;
  53.  
  54.   Permit      : ARRAY[1..4] OF BOOLEAN;
  55.  
  56.   omdpos,
  57.   omdseq      : WORD;
  58.  
  59.   wPastIdx,
  60.   wActIdx,
  61.   wFutIdx     : TWindow;
  62.   wPast,
  63.   wAct,
  64.   wFut        : TChWindows;
  65.  
  66.  
  67.  
  68.  
  69.  
  70. PROCEDURE SetPartWindow(x, y, p, f: WORD);
  71.   BEGIN
  72.     wx := x;
  73.     wn := 20;
  74.     py := y;
  75.     fy := y + p + 5;
  76.     hp := p + 2;
  77.     hf := f + 2;
  78.  
  79.     FillChar(Permit, SIZEOF(Permit), 0);
  80.  
  81.     PastNotes   := p;
  82.     FutNotes    := f;
  83.     TotNotes    := p+f+1;
  84.     ActNote     := p+1;
  85.   END;
  86.  
  87.  
  88.  
  89.  
  90. PROCEDURE SetBigPartWindow;
  91.   BEGIN
  92.     wPastIdx := wPartPastBIdx;
  93.     wActIdx  := wPartActBIdx;
  94.     wFutIdx  := wPartFutBIdx;
  95.     wPast    := wPartPastBig;
  96.     wAct     := wPartActBig;
  97.     wFut     := wPartFutBig;
  98.     PartWin  := @wPartBig;
  99.  
  100.     PastNotes   := 16;
  101.     FutNotes    := 16;
  102.     TotNotes    := 33;
  103.     ActNote     := 17;
  104.     IsBig       := TRUE;
  105.   END;
  106.  
  107.  
  108.  
  109.  
  110. PROCEDURE SetSmallPartWindow;
  111.   BEGIN
  112.     wPastIdx := wPartPastIdx;
  113.     wActIdx  := wPartActIdx;
  114.     wFutIdx  := wPartFutIdx;
  115.     wPast    := wPartPast;
  116.     wAct     := wPartAct;
  117.     wFut     := wPartFut;
  118.     PartWin  := @wPartSmall;
  119.  
  120.     PastNotes   := 5;
  121.     FutNotes    := 5;
  122.     TotNotes    := 11;
  123.     ActNote     := 6;
  124.     IsBig       := FALSE;
  125.   END;
  126.  
  127.  
  128.  
  129.  
  130.  
  131. PROCEDURE InsertStr(VAR s, t: STRING; p: WORD); ASSEMBLER;
  132.   ASM
  133.         PUSH    DS
  134.         CLD
  135.         LDS     SI,t
  136.         LES     DI,s
  137.         MOV     AX,p
  138.         ADD     DI,AX
  139.         LODSB
  140.         MOV     CL,AL
  141.         XOR     CH,CH
  142.         REP MOVSB
  143.         POP     DS
  144.   END;
  145.  
  146.  
  147.  
  148. PROCEDURE StrNote(nt: TFullNote; VAR s: TFullNoteStr);
  149.   CONST
  150.     Commands : ARRAY[mcNone..mcLast] OF STRING[5] = (
  151.       '····',
  152.  
  153.       'ARPG', 'TPUP', 'TPDN', 'NOTP',
  154.       'VIBR', 'TVSL', 'VVSL', 'TREM',
  155.       'XX-1', 'SOFF', 'VSLD', 'JUMP',
  156.       'VOLM', 'BRCK', 'XX-2', 'TEMP',
  157.  
  158.       'FILT', 'FPUP', 'FPDN', 'GLIS',
  159.       'VCTL', 'FTUN', 'LOOP', 'TRMC',
  160.       '?? 3', 'RETN', 'VFUP', 'VFDN',
  161.       'NCUT', 'NDLY', 'PDLY', 'FUNK',
  162.  
  163.       'ARP1', 'ARP2',
  164.  
  165.       '····'
  166.     );
  167.   VAR
  168.     bs : STRING[16];
  169.   BEGIN
  170.  
  171.     s := ' ················ ';
  172.  
  173.     IF (nt.Period <> 0) OR (nt.Instrument <> 0) THEN
  174.       BEGIN
  175.         s[8] := ' ';
  176.         s[5] := ' ';
  177.  
  178.         IF nt.Period = 0 THEN
  179.           BEGIN
  180.             bs := '---';
  181.             InsertStr(s, bs, 2);
  182.           END
  183.         ELSE
  184.           BEGIN
  185.             NoteFreq(nt.Period, bs);
  186.             InsertStr(s, bs, 2);
  187.           END;
  188.  
  189.         IF nt.Instrument = 0 THEN
  190.           BEGIN
  191.             bs := '--';
  192.             InsertStr(s, bs, 6);
  193.           END
  194.         ELSE
  195.           BEGIN
  196.             STR(nt.Instrument : 2, bs);
  197.             IF bs[1] = ' ' THEN bs[1] := '0';
  198.             InsertStr(s, bs, 6);
  199.           END;
  200.       END;
  201.  
  202.     IF nt.Volume <> 0 THEN
  203.       BEGIN
  204.         s[8]  := ' ';
  205.         s[10] := ' ';
  206.         IF nt.Volume < 39 THEN
  207.           s[9] := CHAR(((nt.Volume - 1) SHR 2) + BYTE('0'))
  208.         ELSE
  209.           s[9] := CHAR(((nt.Volume - 1) SHR 2) - 10 + BYTE('A'));
  210.       END;
  211.  
  212.     IF nt.Command <> mcNone THEN
  213.       BEGIN
  214.         s[10] := ' ';
  215.         s[15] := ' ';
  216.  
  217.         IF nt.Command < mcLast THEN
  218.           InsertStr(s, Commands[nt.Command], 11)
  219.         ELSE
  220.           BEGIN
  221.             STR(ORD(nt.Command) - ORD(mcLast) : 2, bs);
  222.             bs := 'X-'+bs;
  223.             InsertStr(s, bs, 11);
  224.           END;
  225.  
  226.         bs := HexByte(nt.Parameter);
  227.         InsertStr(s, bs, 16);
  228.       END;
  229.   END;
  230.  
  231.  
  232.  
  233.  
  234. PROCEDURE DrawPartiture(VAR Song: TSong; mdpos, mdseq: WORD);
  235.   CONST
  236.     EmptyLine : STRING[18] = '                  ';
  237.     count : WORD = 0;
  238.   VAR
  239.     PattSize : WORD;
  240.     nn   : WORD;
  241.     n, w,
  242.     k, p : INTEGER;
  243.     i, j : WORD;
  244.     nt   : TFullNote;
  245.     strn : STRING;
  246.   BEGIN
  247.  
  248.     IF NOT (PartWin^.vis AND PartWin^.act) THEN EXIT;
  249.  
  250.     FOR j := 1 TO 4 DO BEGIN
  251.  
  252.       IF PartWin^.forz THEN
  253.         BEGIN
  254.           STR(FirstChannel-1+j : 2, strn);
  255.           WITH wPast[j] DO 
  256.             DirectWriteAttr(ParseCoords(x+13, y), strn, BYTE(col[4]));
  257.         END;
  258.  
  259.  
  260.       IF NOT Permisos[FirstChannel - 1 + j] THEN BEGIN
  261.         IF {Permit[j] OR }PartWin^.forz THEN BEGIN
  262.           WITH wPast[j] DO BEGIN
  263.             FOR i := 1 TO PastNotes DO
  264.               DirectWriteAttr(ParseCoords(x + 1, y+i), EmptyLine, BYTE(col[3]));
  265.             WriteVTLogo(ParseCoords(x + 6, y+(PastNotes - 1) DIV 2 - 1));
  266.           END;
  267.  
  268.           WITH wAct[j] DO BEGIN
  269.             FOR i := 1 TO 2 DO
  270.               DirectWriteAttr(ParseCoords(x + 1, y+i), EmptyLine, BYTE(col[1]));
  271.             WriteVTNoPartAct(ParseCoords(x + 2, y+1));
  272.           END;
  273.  
  274.           WITH wFut[j] DO BEGIN
  275.             FOR i := 1 TO FutNotes DO
  276.               DirectWriteAttr(ParseCoords(x + 1, y+i), EmptyLine, BYTE(col[3]));
  277.             WriteVTLogo(ParseCoords(x + 6, y+(FutNotes - 1) DIV 2 - 1));
  278.           END;
  279.         END;
  280.       END;
  281.  
  282.       Permit[j] := Permisos[FirstChannel - 1 + j];
  283.     END;
  284. {
  285.     PartWin^.forz := TRUE;
  286. }
  287.     PattSize := 0;
  288.     IF (Song.GetPatternSeq(mdseq)       <> NIL) AND
  289.        (Song.GetPatternSeq(mdseq)^.Patt <> NIL) THEN
  290.       PattSize := Song.GetPatternSeq(mdseq)^.Patt^.NNotes;
  291.  
  292.     IF PartWin^.forz OR (mdseq <> omdseq) OR
  293.        (WORD(mdpos - omdpos) >= FutNotes) THEN BEGIN
  294.  
  295.       FirstNote := 1;
  296.  
  297.       n := mdpos - PastNotes;
  298.       w := 1;
  299.  
  300.       FOR i := 1 TO PastNotes + FutNotes + 1 DO
  301.         BEGIN
  302.           IF (WORD(n) <= PattSize) AND (n <> 0) THEN
  303.             FOR j := 1 TO 4 DO
  304.               BEGIN
  305.                 Song.GetNote(mdseq, n, FirstChannel - 1 + j, nt);
  306.                 ls[w][j] := nt;
  307.                 fs[w][j] := TRUE;
  308.                 StrNote(nt, ps[w][j]);
  309.               END
  310.           ELSE
  311.             FOR j := 1 TO 4 DO
  312.               BEGIN
  313.                 ls[w][j].Instrument := $FF;
  314.                 fs[w][j] := TRUE;
  315.                 ps[w][j] := '                  ';
  316.               END;
  317.           INC(n); INC(w);
  318.         END;
  319.  
  320.     END ELSE BEGIN
  321.  
  322.       k := mdpos - omdpos;
  323.       IF k = 0 THEN EXIT;
  324.       IF k > 0 THEN BEGIN
  325.         p := 1;
  326.         n := omdpos + FutNotes + 1;
  327.       END;
  328.  
  329.       w  := FirstNote;
  330.       nn := ((FirstNote - 1 + TotNotes + k) MOD TotNotes) + 1;
  331.       FOR i := 1 TO TotNotes - k DO BEGIN
  332.         FOR j := 1 TO 4 DO
  333.           fs[nn][j] := NOT FullNotesEqual(ls[nn][j], ls[w][j]);
  334.         w  := (w  MOD TotNotes) + 1;
  335.         nn := (nn MOD TotNotes) + 1;
  336.       END;
  337.  
  338.       w := FirstNote;
  339.       FirstNote := ((FirstNote - 1 + TotNotes + k) MOD TotNotes) + 1;
  340.  
  341.       FOR i := 1 TO ABS(k) DO BEGIN
  342.         IF (WORD(n) <= PattSize) AND (n <> 0) THEN
  343.           FOR j := 1 TO 4 DO
  344.             BEGIN
  345.               Song.GetNote(mdseq, n, FirstChannel - 1 + j, nt);
  346.               ls[w][j] := nt;
  347.               fs[w][j] := TRUE;
  348.               StrNote(nt, ps[w][j]);
  349.             END
  350.         ELSE
  351.           FOR j := 1 TO 4 DO
  352.             BEGIN
  353.               fs[w][j] := ls[w][j].Instrument <> $FF;
  354.               ls[w][j].Instrument := $FF;
  355.               ps[w][j] := '123456789012345678';
  356.             END;
  357.         INC(n, p);
  358.         w := ((w - 1 + TotNotes + p) MOD TotNotes) + 1;
  359.       END;
  360.  
  361.     END;
  362.  
  363.     n  := FirstNote;
  364.     nn := mdpos - PastNotes;
  365.  
  366.     FOR i := 1 TO PastNotes DO BEGIN
  367.       WITH wPastIdx DO BEGIN
  368.         STR(nn : 2, strn);
  369.         IF (nn <= PattSize) AND (nn <> 0) THEN
  370.           DirectWriteAttr(ParseCoords(x+1, y+i), strn, BYTE(col[1]))
  371.         ELSE
  372.           DirectWriteAttr(ParseCoords(x+1, y+i), '  ', BYTE(col[2]));
  373.       END;
  374.  
  375. {
  376.       IF ps[n][1][0] <> #0 THEN
  377. }
  378.         FOR j := 1 TO 4 DO
  379.           IF fs[n][j] THEN
  380.             IF Permisos[FirstChannel - 1 + j] THEN
  381.               WITH wPast[j] DO IF ls[n][j].Instrument = $FF THEN
  382.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[2]))
  383.               ELSE
  384.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[1]));
  385.       n := (n MOD TotNotes) + 1;
  386.       INC(nn);
  387.     END;
  388.  
  389.     WITH wActIdx DO BEGIN
  390.       IF nn < 100 THEN
  391.         STR(nn : 2, strn)
  392.       ELSE
  393.         strn := '  ';
  394.       DirectWriteBig(ParseCoords(x+1, y+1), strn)
  395.     END;
  396.  
  397.     FOR j := 1 TO 4 DO
  398.       IF fs[n][j] THEN
  399.         IF Permisos[FirstChannel - 1 + j] THEN
  400.           WITH wAct[j] DO BEGIN
  401.             RectAttr       (ParseCoords(x+1, y+1), 18, 2, BYTE(col[1]));
  402.             DirectWriteBig (ParseCoords(x+1, y+1), ps[n][j]);
  403.           END;
  404.     n := (n MOD TotNotes) + 1;
  405.     INC(nn);
  406.  
  407.     FOR i := 1 TO FutNotes DO BEGIN
  408.       WITH wFutIdx DO BEGIN
  409.         STR(nn : 2, strn);
  410.         IF (nn <= PattSize) AND (n <> 0) THEN
  411.           DirectWriteAttr(ParseCoords(x+1, y+i), strn, BYTE(col[1]))
  412.         ELSE
  413.           DirectWriteAttr(ParseCoords(x+1, y+i), '  ', BYTE(col[2]));
  414.       END;
  415.  
  416. {
  417.       IF ps[n][1][0] <> #0 THEN
  418. }
  419.         FOR j := 1 TO 4 DO
  420.           IF fs[n][j] THEN
  421.             IF Permisos[FirstChannel - 1 + j] THEN
  422.               WITH wFut[j] DO IF ls[n][j].Instrument = $FF THEN
  423.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[2]))
  424.               ELSE
  425.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[1]));
  426.       n := (n MOD TotNotes) + 1;
  427.       INC(nn);
  428.     END;
  429.  
  430.     omdseq := mdseq;
  431.     omdpos := mdpos;
  432.  
  433.     PartWin^.forz := FALSE;
  434.  
  435.   END;
  436.  
  437.  
  438.  
  439.  
  440. END.
  441.